home *** CD-ROM | disk | FTP | other *** search
/ AMIGA-CD 2 / Amiga-CD - Volume 2.iso / ungepackte_daten / 1994 / 7 / 02 / tips&tricks / finalwriter / finalwrapper / finalwrapper.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1995-06-01  |  14.1 KB  |  467 lines
  1. /* $VER: FinalWrapper 1.3 (27.04.94) by NDY's */
  2.  
  3. /* Main [1.3] */
  4. OPTIONS RESULTS
  5. SIGNAL ON ERROR
  6. SIGNAL ON SYNTAX
  7. CALL init
  8. CALL locale
  9. CALL chosenobjs
  10. CALL options
  11. CALL pointnoval
  12. IF txt>0 THEN
  13.   CALL textblock
  14. ELSE
  15.   CALL bodytext
  16. CALL initwrap
  17. CALL wrap
  18. CALL link
  19. CALL bye
  20.  
  21. PROC init: /* Initialization [1.3] */
  22.   /* Vars needed by "bye" / "ERROR" */
  23.   errtext='"%t" "(#%n) in line %l" "" "Ok" "" ""'
  24.   objs=0
  25.   deci=""
  26.   et=""
  27.   /* Open library */
  28.   library="rexxmathlib.library"
  29.   lib=Show("l",library)
  30.   IF ~lib THEN lib=AddLib(library,0,-30,0)
  31.   IF ~lib | test=1 THEN
  32.     DO
  33.       ShowMessage 1 1 replacepat(nolib,"%y",library)
  34.       CALL bye(14)
  35.     END
  36.   clip="FWrapper.def"
  37.   default=GetClip(clip)
  38. RETURN
  39. PROC locale: /* Language specific strings [1.3] */
  40.   test=0  /* test 1/2/3/6/10/20/100/200 with new languages, 0 = no test */
  41.   lang=getlanguage()
  42.   info='FinalWrapper 1.3 by NDY''s'
  43.   /* IF default='' THEN default='(put your defaults here and uncomment this line)' */
  44.   IF lang="deutsch" THEN /* German */
  45.     DO
  46.       errtext='"FinalWrapper-Fehler:" "%t" "in Zeile %l (Fehlernummer %n)" "Ok" "" ""'
  47.       noselect='"FinalWrapper-Fehler:" "Zuerst einen Textblock oder einen" "Textausschnitt und ein Oval wählen!" "Ok" "" ""'
  48.       input='"%i" "Sektorgrösse eingeben (? für Hilfe)" "%d"'
  49.       help.0='"Syntax (Argumente in Klammern optional):" "[[A]±n] [D±|D=] [R±|R=|R±n|Rn] [G±] [S±n|S±] [@±n] [H±n] [O±] [?]" "A: Sektorgrösse (0 bis 360), - Text umdrehen. Voreinst.: 360"'
  50.       help.1='"Rotieren: Voreinstellung: +0. R+ entspricht R+90, R- R-90" "R+n / R-n dreht jedes Zeichen um weitere n Grad (0 bis 180)" "Rn setzt die Drehung aller Zeichen auf n, R= gleich der des Textblocks"'
  51.       help.2='"D (Löschen): Voreinst.: Nur Oval wird gelöscht. D+ auch" "der Textblock wird gelöscht. D- weder Oval noch" "Textblock gelöscht. D= Oval wird kopiert und gelöscht"'
  52.       help.3='"Gruppierung: Voreinst.: Oval nicht mitgruppieren" "G+ Oval zum Objekt hinzugruppieren" "G- Oval unsichtbar hinzugruppieren"'
  53.       help.4='"Startpunkt: Voreinstellung: 0" "S+n verschiebt den Anfang um n Grad gegen und" "S-n mit dem Uhrzeigersinn (S+ = S+90, S- = S-90)"'
  54.       help.5='"@ (Spirale): Voreinst.: 0.  @n erzeugt eine Spirale mit ei-" "nem inneren Radius von n% des äusseren. @-n funktio-" "niert analog, jedoch beginnt die Spirale im Innern"'
  55.       help.6='"Höhe: Voreinst.: Wert von @, wenn angegeben," "sonst 0. Hn funktioniert wie @n, betrifft aber" "die Grösse der Zeichen statt des Radius"'
  56.       help.7='"Optionen speichern: Voreinst.: Nicht speichern" "O+ alle Optionen speichern" "O- alle ausser O- speichern und Abbruch"'
  57.       helpbutton='"Letzte Seite" "Zurück" "Nächste Seite"'
  58.       helppages=8
  59.       fwerrtext.10='Befehl gescheitert'
  60.       fwerrtext.20='Ungültige Argumente'
  61.       fwerrtext.100='Befehl unbekannt'
  62.       fwerrtext.200='Kann fwarexx.library nicht öffnen'
  63.       nolib='"FinalWrapper-Fehler:" "Konnte ''%y'' nicht öffnen!" "" "Ok" "" ""'
  64.     END
  65.   ELSE /* Default: English */
  66.     DO
  67.       errtext='"FinalWrapper failed:" "%t" "in line %l (errornumber %n)" "Ok" "" ""'
  68.       noselect='"FinalWrapper failed:" "Select an oval and a textblock or" "some text before calling FinalWrapper!" "Ok" "" ""'
  69.       input='"%i" "Enter sector size (? for help)" "%d"'
  70.       help.0='"Syntax (arguments in brackets are optional):" "[[A]±n] [D±|D=] [R±|R=|R±n|Rn] [G±] [S±n|S±] [@±n] [H±n] [O±] [?]" "Angle: Sectorsize (0 to 360), - flips the text. Default: 360"'
  71.       help.1='"Rotate: Default: +0. R+ is equal to R+90, R- to R-90" "R+n / R-n rotates each letter for another n degrees (0 to 180)" "Rn sets rotation of all letters to n, R= equal to the textblock''s"'
  72.       help.2='"Delete: Default: Only oval deleted. D+ deletes" "the textblock as well. D- prevents the oval from" "being deleted. D= copies oval before deleting it"'
  73.       help.3='"Group: Default: Don''t group." "G+ group oval to object" "G- make oval invisible and group it"'
  74.       help.4='"Starting point: Default: 0" "S+n moves the start n degree anticlockwise" "S-n moves it clockwise (S+ = S+90, S- = S-90)"'
  75.       help.5='"@ (spiral): Default: 0. @n creates a spiral with an inner" "radius of n% of the outer one. @-n works equal" "exept that the spiral now starts at the inside"'
  76.       help.6='"Height: Default: Value from @ if given, else 0" "Hn works as @n, but it affects the height of" "the characters, not the radius"'
  77.       help.7='"Save options: Default: Don''t save" "O+ save all options" "O- save all options exept O- and cancel"'
  78.       helpbutton='"Previous" "Back" "Next"'
  79.       helppages=8
  80.       fwerrtext.10='Instruction failed'
  81.       fwerrtext.20='Invalid arguments'
  82.       fwerrtext.100='Unknown instruction'
  83.       fwerrtext.200='Couldn''t open fwarexx.library'
  84.       nolib='"FinalWrapper failed:" "Couldn''t open ''%y''" "" "Ok" "" ""'
  85.     END
  86.   input=replacepat(input,"%i",info)
  87.   IF test>5 THEN
  88.     DO
  89.       RC=test
  90.       IF test=6 THEN SIGNAL SYNTAX
  91.       SIGNAL ERROR
  92.     END
  93. RETURN
  94. PROC chosenobjs: /* Selected objects [1.3] */
  95.   /* Selected objects */
  96.   txt=0
  97.   oval=0
  98.   len=0
  99.   FirstObject "SELECTED"
  100.   o=RESULT
  101.   IF o~=0 THEN
  102.     DO
  103.       cnt=0
  104.       DO UNTIL o=0
  105.         obj.cnt=o
  106.         NextObject o "SELECTED"
  107.         o=RESULT
  108.         cnt=cnt+1
  109.       END
  110.       /* Search oval and textblock */
  111.       DO i=0 TO cnt-1 WHILE oval=0 | txt=0
  112.         GetObjectType obj.i
  113.         IF RESULT=7 THEN txt=obj.i
  114.         IF RESULT=6 THEN oval=obj.i
  115.       END
  116.       /* Selected text */
  117.       IF txt=0 THEN
  118.         DO
  119.           Extract
  120.           text=RESULT
  121.           len=Length(text)
  122.         END
  123.     END
  124.   IF (txt=0 & len<=1 | oval=0 | test=2) & test~=3 THEN
  125.     DO
  126.       ShowMessage 1 1 noselect
  127.       CALL bye(5)
  128.     END
  129. RETURN
  130. PROC options: /* Input [1.3] */
  131.   about=0
  132.   DO UNTIL about=-1 & test~=3
  133.     RequestText replacepat(input,"%d",default)
  134.     /* Help */
  135.     IF Pos("?",RESULT)>0 | test=3 THEN
  136.       DO
  137.         default=replacepat(RESULT,"?","")
  138.         about=0
  139.         DO UNTIL RESULT=2
  140.           ShowMessage 2 0 help.about helpbutton
  141.           about=(about+RESULT-2+helppages)//helppages
  142.         END
  143.       END
  144.     ELSE
  145.       about=-1
  146.   END
  147.   PARSE UPPER VAR RESULT "A" ssize " ","D" del " ","R" rrot " ","G" link " ","S" start " ","@" rdim " ","H" hdim " ","O" opt " "
  148.   IF opt="-" THEN 
  149.     DO
  150.       CALL SetClip(clip,Trim(replacepat(Upper(RESULT),"O-","")))
  151.       CALL bye(0)
  152.     END
  153.   IF opt="+" THEN CALL SetClip(clip,Upper(RESULT))
  154.   IF ssize="" THEN PARSE UPPER VAR RESULT ssize " "
  155.   /* Verify and set defaults (x||"0": ± -> ±0) */
  156.   IF ~Datatype(ssize,"W") | ssize="" THEN ssize=360
  157.   IF ssize=0 THEN ssize=0.01 /* no division by zero */
  158.   IF ~Datatype(rrot||"0","W") & rrot~="=" THEN rrot=""
  159.   IF link~="+" & link~="-" THEN link=""
  160.   IF start="+" | start="-" THEN start=start||"90"
  161.   IF ~Datatype(start,"W") THEN start=0
  162.   start=Max(Min(start,180),-180)
  163.   IF del~="+" & del~="-" & del~="=" THEN del=""
  164.   IF ~Datatype(hdim,"W") THEN hdim=""
  165.   IF ~Datatype(rdim,"W") THEN rdim=""
  166.   IF rdim="" THEN
  167.     ssize=Max(Min(ssize,360),-360)
  168.   ELSE
  169.     rdim=Max(Min(rdim,100),-100)
  170.   IF ~Datatype(hdim,"W") THEN hdim=""
  171.   IF hdim="" THEN
  172.     hdim=rdim
  173.   ELSE
  174.     hdim=Max(Min(hdim,100),-100)
  175.   /* Relative rotation */
  176.   drot=0
  177.   IF Verify(Left(rrot,1),"+-","m")>0 THEN
  178.     DO
  179.       IF Length(rrot)=1 THEN
  180.         drot=rrot||"90"
  181.       ELSE
  182.         drot=Max(Min(rrot,180),-180)
  183.       rrot=""
  184.     END
  185.   ELSE
  186.     IF rrot~="" THEN rrot=Max(Min(rrot,360),-360)
  187. RETURN
  188. PROC pointnoval: /* Decimal point & process oval [1.3] */
  189.   /* Use decimal point */
  190.   GetDocItemPrefs "DECIMAL"
  191.   deci=RESULT
  192.   DocItemPrefs "DECIMAL PERIOD"
  193.   /* Examine oval */
  194.   GetObjectRotation oval
  195.   orot=RESULT
  196.   IF orot~=0 THEN SetObjectRotation oval 0
  197.   GetObjectCoords oval
  198.   PARSE VAR RESULT page x y rx ry
  199.   rx=rx/2
  200.   ry=ry/2
  201.   xm=x+rx
  202.   ym=y+ry
  203.   /* Use oval's text flow settings */
  204.   GetObjectParams oval "TEXTFLOW FLOWDIST"
  205.   flow=Word(RESULT,1)
  206.   IF Left(flow,5)="Right" THEN
  207.     flow="Right"
  208.   ELSE
  209.     IF Left(flow,4)="Left" THEN flow="Left"
  210.   fld=Word(RESULT,2)
  211.   TextBlockPrefs "TEXTFLOW" flow "FLOWDIST" fld
  212.   IF del="=" THEN
  213.     DO
  214.       SelectObject oval
  215.       Copy
  216.     END
  217.   IF del~="-" & link="" THEN DeleteObject oval
  218. RETURN
  219. PROC textblock: /*  Process textblock [1.3] */
  220.   spcs=0
  221.   /* Examine textblock */
  222.   GetTextBlockText txt
  223.   text=RESULT
  224.   text=rembad(text)
  225.   len=Length(text)
  226.   GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  227.   PARSE VAR RESULT size lead wid obl pos case st col font
  228.   TextBlockTypePrefs "SIZE" size "LEADING" lead "WIDTH" wid "OBLIQUE" obl "POSITION" pos "CASE" case "STYLE" st "COLOR" col "FONT" font
  229.   GetObjectCoords txt
  230.   txtw=Word(RESULT,4)
  231.   /* Get rotation */
  232.   IF rrot="=" THEN
  233.     DO
  234.       GetObjectRotation txt
  235.       rrot=RESULT
  236.     END
  237.   IF del="+" THEN DeleteObject txt
  238. RETURN
  239. PROC bodytext: /* Process selected text [1.3] */
  240.   IF rrot="=" THEN rrot=0
  241.   txtw=0
  242.   spcs=0
  243.   /* Remove CR at the end */
  244.   IF C2X(Right(text,1))="0A" THEN
  245.     DO
  246.       len=len-1
  247.       text=Left(text,len)
  248.     END
  249.   text=rembad(text)
  250.   /* Cursor to the beginning */
  251.   DO i=2 TO len
  252.     Cursor "LEFT"
  253.   END
  254.   /* Create textobjects */
  255.   DO i=1 TO len
  256.     x=SubStr(text,i,1)
  257.     IF x=" " THEN
  258.       spcs=spcs+1
  259.     ELSE
  260.       DO
  261.         specs=gettexttypespecs()
  262.         TextBlockTypePrefs specs
  263.         IF Verify(x,'";=',"M")  THEN x='"'||x||'"'
  264.         DrawTextBlock page xm ym x
  265.         /* Save size & number */
  266.         objs=objs+1
  267.         GetObjectCoords 0
  268.         PARSE VAR RESULT x x x objw.objs objh.objs
  269.         txtw=txtw+objw.objs
  270.         CurrentObject
  271.         obj.objs=RESULT
  272.       END
  273.     IF i<len THEN Cursor "RIGHT"
  274.   END
  275. RETURN
  276. PROC initwrap: /* Init wrapping [1.3] */
  277.   /* Width of a space */
  278.   DrawTextBlock page xm ym "- -"
  279.   GetObjectCoords 0
  280.   spcw=Word(RESULT,4)
  281.   DeleteObject
  282.   DrawTextBlock page xm ym "--"
  283.   GetObjectCoords 0
  284.   h=Word(RESULT,5)
  285.   spcw=spcw-Word(RESULT,4)
  286.   DeleteObject
  287.   PI=3.141593
  288.   smin=0.1 /* Minimal size */
  289.   txtw=txtw+spcs*spcw
  290.   sizerad=ssize/180*PI
  291.   angstep=sizerad/txtw
  292.   angstart=(ssize-360+start*2)/360*PI
  293.   ssize=ssize<0
  294.   IF rdim="" THEN
  295.     qr=1
  296.   ELSE
  297.     DO
  298.       fr=(1-Abs(rdim)/100)/sizerad*Sign(rdim)
  299.       IF rdim<0 THEN
  300.         fr0=Abs(rdim)/100
  301.       ELSE
  302.         fr0=1
  303.     END
  304.   IF hdim="" THEN
  305.     qh=1
  306.   ELSE
  307.     DO
  308.       fh=(1-Abs(hdim)/100)/sizerad*Sign(hdim)
  309.       IF hdim<0 THEN
  310.         fh0=Abs(hdim)/100
  311.       ELSE
  312.         fh0=1
  313.     END
  314.   wdone=0
  315.   o=0
  316.   nr=0
  317. RETURN
  318. PROC wrap: /* Wrap it! [1.3] */
  319.   DO n=1 TO len
  320.     char=SubStr(text,n,1)
  321.     IF char~=" " THEN
  322.       DO
  323.         IF txt>0 THEN
  324.           DO
  325.             /* Draw and get size */
  326.             IF Verify(char,'";=',"M")  THEN char='"'||char||'"'
  327.             DrawTextBlock page xm ym char
  328.             GetObjectCoords 0
  329.             cw=Word(RESULT,4)
  330.             ch=h
  331.             CurrentObject
  332.             objs=objs+1
  333.             obj.objs=RESULT
  334.           END
  335.         ELSE
  336.           DO
  337.             /* Number and size saved before */
  338.             nr=nr+1
  339.             cw=objw.nr
  340.             ch=objh.nr
  341.             o=obj.nr
  342.           END
  343.         f=angstart-angstep*(wdone+cw/2)
  344.         wdone=wdone+cw
  345.         /* Spirals */
  346.         IF rdim~="" THEN qr=fr0+fr*(f-angstart)
  347.         IF hdim~="" THEN
  348.           DO
  349.             qh=fh0+fh*(f-angstart)
  350.             ch=Max(ch*qh,smin)
  351.             cw=Max(cw*qh,smin)
  352.           END
  353.         x=rx*Sin(f)*qr-cw/2
  354.         y=ry*Cos(f)*qr-ch/2
  355.         /* Rotation */
  356.         IF rrot="" THEN
  357.           rot=720-Trunc(Atan(ry/rx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)+drot
  358.           /* Circles only: rot=Trunc(ssize*180+180-f/PI*180)+drot */
  359.         ELSE
  360.           rot=rrot
  361.         /* Centre char on the oval */
  362.         SetObjectCoords o page x+xm y+ym cw ch
  363.         SetObjectRotation o rot//360
  364.       END
  365.     ELSE
  366.       DO
  367.         wdone=wdone+spcw
  368.         spcs=spcs+1
  369.       END
  370.   END
  371. RETURN
  372. PROC link: /* Group objects [1.3] */
  373.   /* Hide oval */
  374.   IF link="-" THEN
  375.     DO
  376.       SelectObject oval
  377.       SetObjectParams oval "LINEWT NONE FILL TRANSPARENT"
  378.     END
  379.   /* Rotate oval back */
  380.   IF orot~=0 & del="-" & link="" THEN SetObjectRotation oval orot
  381.   /* Group chars */
  382.   SelectObject
  383.   DO n=1 TO objs
  384.     SelectObject obj.n "MULTIPLE"
  385.   END
  386.   IF link~="" THEN SelectObject oval "MULTIPLE"
  387.   Group
  388.   objs=0
  389.   IF orot~=0 THEN SetObjectRotation 0 orot
  390.   Redraw
  391. RETURN
  392. PROC bye: /* CALL bye(returnvalue)  You MUST use this instead of EXIT! [1.3] */
  393.   PARSE ARG errnr
  394.   /* Restore decimal delimitter */
  395.   IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  396.   IF lib=1 THEN CALL RemLib(library)
  397.   IF objs~=0 THEN
  398.     DO n=1 TO objs
  399.       DeleteObject obj.n
  400.     END
  401.   EXIT errnr
  402. RETURN
  403. PROC SYNTAX: /* SYNTAX & ERROR handling [1.3] */
  404.   et=ErrorText(RC)
  405. ERROR:
  406.   line=SIGL
  407.   nr=RC
  408.   IF et="" THEN et=fwerrtext.nr
  409.   IF nr>5 THEN ShowMessage 1 1 replacepat(replacepat(replacepat(errtext,"%n",nr),"%l",line),"%t",et)
  410.   CALL bye(nr)
  411. RETURN
  412. PROC rembad: PROCEDURE /* newstr=rembad(str) [1.1] */
  413.   /* Replace unprintable characters by spaces */
  414.   PARSE ARG t
  415.   bad=XRange("00"x,"1F"x)||XRange("7F"x,"9F"x)
  416.   i=Verify(t,bad,"m")
  417.   l=Length(t)
  418.   DO WHILE i>0
  419.     t=Left(t,i-1) Right(t,l-i)
  420.     i=Verify(t,bad,"m")
  421.   END
  422. RETURN t
  423. PROC replacepat: PROCEDURE /* newstr=replacepat(str,pat,replc) [1.2] */
  424.   /* Replace all occurences of a pattern in a string by another one */
  425.   PARSE ARG str,pat,replc
  426.   p=Pos(pat,str)
  427.   DO WHILE p>0
  428.     str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  429.     p=Pos(pat,str)
  430.   END
  431. RETURN str
  432. PROC getlanguage: PROCEDURE /* language=getlanguage() [1.3] */
  433.   /* Get preferred language */
  434.   ok=Open(prefs,"ENV:Locale","R")
  435.   IF ok THEN
  436.     DO
  437.       language=ReadLn(prefs)
  438.       CALL Close(prefs)
  439.     END
  440. RETURN language
  441. PROC gettexttypespecs: PROCEDURE /*  specs=gettexttypespecs() [1.3] */
  442.   Status "FONTSIZE"
  443.   p="SIZE" RESULT
  444.   Status "FONTLEADING"
  445.   p=p "LEADING" RESULT
  446.   Status "FONTWIDTH"
  447.   p=p "WIDTH" RESULT
  448.   Status "FONTOBLIQUE"
  449.   p=p "OBLIQUE" RESULT
  450.   Status "FONTPOSITION"
  451.   p=p "POSITION" RESULT
  452.   Status "FONTCASE"
  453.   p=p "CASE" RESULT
  454.   Status "FONTSTYLE"
  455.   p=p "STYLE" RESULT
  456.   Status "FONTCOLOR"
  457.   p=p "COLOR" RESULT
  458.   Status "FONTNAME"
  459.   p=p "FONT" RESULT
  460. RETURN p
  461. PROC dump: PROCEDURE /* CALL dump(var[,infostr]) [1.3] */
  462.   /* Dump a variable, %v in infostring determines it's place (debug-only) */
  463.   PARSE ARG v,info
  464.   IF info="" THEN info="%v"
  465.   ShowMessage 1 1 '"'||replacepat(info,"%v",v)||'" "" "" "Ok" "" ""'
  466. RETURN
  467.